home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qbmouse.zip
/
BITMAP.BAS
next >
Wrap
BASIC Source File
|
1993-07-06
|
8KB
|
225 lines
' Filename: BITMAP.BAS.
' A bitmap editor to produce 16 x 16 bitmaps to use as graphics mouse
' pointers, with the function MouseGraphicsPtr. This is a very simple
' and rather primitive bitmap editor, with no fancy stuff. However, it
' is certainly MUCH simpler than figuring out the bitmap integers by
' hand, yourself. ;-) After starting the program, wait for the the
' mouse pointer to appear, then put it on the bit in the bitmap grid
' on the left which you wish to change, then press one of the mouse
' buttons, then move the pointer a few grid boxes away from that one
' to ensure that the pointer doesn't interfere with drawing lines and
' such. If the bit is set (on) is will be cleared, and if it is off,
' it will be set. A representation of what the bitmap will actually
' look like is shown on the right. When you have finished drawing your
' bitmap, put the mouse pointer on the "Save..." box and press a button.
' You will be asked for a filename to save to (if the file exists, it
' will append to it), and a name for the bitmap (the variable name), and
' the type of screen mask you want (whether the pointer should be
' see-through, or solid, or solid with an outline). Then, it will
' print out the necessary commands to set up the bitmap variable (of
' type BitMap), which you can then merge or include into your code for
' use. A few useful pre-made bitmaps can be found in the file
' BITMAPS.TXT, which you can merge into your code for use, as well.
' Note: This program only creates new bitmaps, which you can then save.
' It does not allow you to edit old, already saved, bitmaps. This would
' be a good feature to add, but I didn't feel like adding it. As I said,
' it is a primitive thing, but still better than drawing out bitmap grids
' by hand and then converting binary to decimal or hex, yourself... ;-)
' I only distribute the (not too pretty) code with this program so that
' you can see a sample of how my mouse functions can be used in a
' program.
' Must include the MOUSE.BI include file...
'$INCLUDE: 'mouse.bi'
' Set screen mode to 2 (640 x 200 resolution, monochrome).
SCREEN 2
CLS
DIM bits(16, 16) AS INTEGER ' 2-D array to store bitmap info
DIM event AS MouseEvent ' A MouseEvent variable
DIM bitline AS INTEGER ' 16 bit integer for pointer map
DIM scrline AS INTEGER ' 16 bit integer for screen map
FOR y = 1 TO 16
FOR x = 1 TO 16
bits(x, y) = FALSE ' Clear all bits of the bitmap
NEXT x
NEXT y
FOR y = 0 TO 75 STEP 5
FOR x = 0 TO 150 STEP 10
LINE (x, y)-(x + 10, y + 5), , B ' Draw bitmap grid
NEXT x
NEXT y
LOCATE 20, 20
PRINT "Save..."
LOCATE 20, 60
PRINT "Quit"
LINE ((19 * 8) - 2, (19 * 8) - 2)-STEP(60, 10), , B ' Save box
LINE ((59 * 8) - 2, (19 * 8) - 2)-STEP(40, 10), , B ' Quit box
LOCATE 2, 55
PRINT "Sample output:"
LOCATE 25, 36
PRINT "Wait...";
IF MouseInit(2) = 0 THEN
GOTO ex ' Exit
END IF
LOCATE 25, 36
PRINT " ";
top:
WHILE NOT MouseButton(event, TRUE) ' Wait for user to press button
WEND
' If mouse is in the bitmap grid...
IF event.x >= 0 AND event.x <= 160 AND event.y >= 0 AND event.y <= 80 THEN
GOTO bitchange
' If mouse is in the Save box...
ELSEIF event.x >= (19 * 8) - 2 AND event.x <= (19 * 8) + 58 AND event.y >= (19 * 8) - 2 AND event.y <= (19 * 8) + 8 THEN
GOTO save
' If mouse is in the quit box...
ELSEIF event.x >= (59 * 8) - 2 AND event.x <= (59 * 8) + 38 AND event.y >= (19 * 8) - 2 AND event.y <= (19 * 8) + 8 THEN
GOTO quit
END IF
GOTO top ' Go back and wait for another button press
bitchange:
xx = INT(event.x / 10) + 1 ' Convert position of mouse on screen to
yy = INT(event.y / 5) + 1 ' index into 2-D array of bitmap info
bits(xx, yy) = NOT bits(xx, yy) ' Flip the bit; off -> on, on -> off
waitformove:
WHILE NOT MouseMove(event) ' Wait for user to move pointer away from the
WEND ' spot, so it doesn't interfere with graphics
' If they haven't moved far enough away yet...
IF INT(event.x / 10) + 1 < xx + 2 AND INT(event.x / 10) + 1 > xx - 4 AND INT(event.y / 5) + 1 < yy + 2 AND INT(event.y / 5) + 1 > yy - 5 THEN
GOTO waitformove
END IF
IF bits(xx, yy) THEN ' Bit is on
LINE ((xx - 1) * 10, (yy - 1) * 5)-STEP(10, 5), , BF ' Fill grid spot
PSET (xx + 500, yy + 50) ' Set pixel on sample display
ELSE ' Bit is off
FOR y = (yy - 1) * 5 TO ((yy - 1) * 5) + 5
FOR x = (xx - 1) * 10 TO ((xx - 1) * 10) + 10
PRESET (x, y) ' Erase grid spot
NEXT x
NEXT y
LINE ((xx - 1) * 10, (yy - 1) * 5)-STEP(10, 5), , B ' Redraw grid box
PRESET (xx + 500, yy + 50) ' Turn off pixel on sample display
END IF
GOTO top ' Go back to wait for another button press
save:
MouseHide ' Turn off mouse
CLS
INPUT "Enter filename to save to: ", file$
PRINT
INPUT "Enter the name of the bitmap: ", nm$
PRINT
PRINT " 0 - See-through pointer"
PRINT " 1 - Solid over-writing pointer"
PRINT " 2 - Solid over-writing pointer, with outline"
PRINT
PRINT "Press the number of your choice to determine screen mask."
scrin:
scrtype$ = INPUT$(1)
IF scrtype$ <> "0" AND scrtype$ <> "1" AND scrtype$ <> "2" THEN
BEEP
GOTO scrin
END IF
ON ERROR GOTO badfile ' File error handler
OPEN file$ FOR APPEND AS #1
PRINT #1,
PRINT #1, " DIM "; nm$; " AS BitMap" ' Dimension command
PRINT #1,
FOR y = 1 TO 16
bitline = 0
dif = 16
FOR x = 16 TO 2 STEP -1 ' Calculate the integers
bitline = bitline + ((bits(x, y) AND 1) * (2 ^ (x - dif)))
dif = dif - 2
NEXT x
IF bits(1, y) THEN ' High bit set in grid
bitline = bitline OR &H8000 ' set high bit of integer
END IF
IF scrtype$ = "0" THEN ' See-through
scrline = NOT 0
ELSEIF scrtype$ = "1" THEN ' Solid
scrline = NOT bitline
ELSE ' Solid with outline
scrline = NOT bitline
FOR b = 0 TO 13
IF (scrline AND (2 ^ b)) <> 0 THEN ' a 1 bit here
IF (scrline AND (2 ^ (b + 1))) = 0 THEN ' Next bit is 0
scrline = scrline AND (NOT (2 ^ b)) ' clear the bit
END IF
END IF
NEXT b
IF (scrline AND &H4000) <> 0 THEN ' 1 at bit 14
IF (scrline AND &H8000) = 0 THEN ' 0 at bit 15
scrline = scrline AND (NOT &H4000) ' clear the bit
END IF
END IF
IF (scrline AND &H8000) <> 0 THEN ' 1 at bit 15
IF (scrline AND &H4000) = 0 THEN ' 0 at bit 14
scrline = scrline AND (NOT &H8000) ' clear the bit
END IF
END IF
FOR b = 14 TO 1 STEP -1
IF (scrline AND (2 ^ b)) <> 0 THEN ' a 1 bit here
IF (scrline AND (2 ^ (b - 1))) = 0 THEN ' prev. bit is 0
scrline = scrline AND (NOT (2 ^ b)) ' clear the bit
END IF
END IF
NEXT b
END IF
' Print out values...
PRINT #1, " "; nm$; ".ptr"; LTRIM$(STR$(y)); " = "; STR$(bitline)
PRINT #1, " "; nm$; ".screen"; LTRIM$(STR$(y)); " = "; STR$(scrline)
NEXT y
GOTO ex ' Exit
quit:
LOCATE 25, 15
PRINT "Do you really want to quit without saving? [y,n]";
qin:
q$ = UCASE$(INKEY$)
IF q$ = "" THEN
GOTO qin
ELSEIF q$ = "N" THEN
LOCATE 25, 13
PRINT SPACE$(54);
GOTO top
ELSEIF q$ = "Y" THEN
MouseHide
GOTO ex
ELSE
BEEP
GOTO qin
END IF
ex:
SCREEN 0
CLS
PRINT "Goodbye..."
PRINT
END
badfile:
IF ERR = 52 OR ERR = 53 OR ERR = 54 OR ERR = 55 OR ERR = 58 OR ERR = 64 OR ERR = 70 OR ERR = 75 OR ERR = 76 THEN
PRINT
PRINT "Bad file name!"
PRINT
INPUT "Reenter file name: ", file$
RESUME
ELSEIF ERR = 57 OR ERR = 61 OR ERR = 67 OR ERR = 68 OR ERR = 71 OR ERR = 72 THEN
PRINT
PRINT "Disk error (full, not ready, etc.)"
PRINT
PRINT "Press any key to continue if problem is corrected."
WHILE INKEY$ = ""
WEND
RESUME
ELSE
ON ERROR GOTO 0
END
END IF